PCMania 45/PCMania CD45_1.iso/vb4wm/vb4-4.cab/blanker.frm

Text File | 1995-10-16 | 29KB | 760 lines

VERSION 4.00
Begin VB.Form DemoForm
   BackColor       =   &H00000000&
   Caption         =   "Demostraci≤n de protector de pantalla"
   ClientHeight    =   4425
   ClientLeft      =   960
   ClientTop       =   1965
   ClientWidth     =   7470
   BeginProperty Font
      name            =   "MS Sans Serif"
      charset         =   1
      weight          =   700
      size            =   8.25
      underline       =   0   'False
      italic          =   0   'False
      strikethrough   =   0   'False
   EndProperty
   ForeColor       =   &H00000000&
   Height          =   5115
   Icon            =   "BLANKER.frx":0000
   Left            =   900
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   ScaleHeight     =   4425
   ScaleWidth      =   7470
   Top             =   1335
   Width           =   7590
   Begin VB.Timer Timer1
      Interval        =   1
      Left            =   6960
      Top             =   120
   End
   Begin VB.CommandButton cmdStartStop
      BackColor       =   &H00000000&
      Caption         =   "Comenzar la demostraci≤n"
      Default         =   -1  'True
      Height          =   390
      Left            =   240
      TabIndex        =   0
      Top             =   120
      Width           =   2430
   End
   Begin VB.PictureBox picBall
      AutoSize        =   -1  'True
      BackColor       =   &H00000000&
      BorderStyle     =   0  'None
      ForeColor       =   &H00FFFFFF&
      Height          =   480
      Left            =   1800
      Picture         =   "BLANKER.frx":030A
      ScaleHeight     =   480
      ScaleWidth      =   480
      TabIndex        =   1
      Top             =   720
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.Image imgMoon
      Height          =   480
      Index           =   8
      Left            =   6330
      Picture         =   "BLANKER.frx":0614
      Top             =   3765
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.Line linLineCtl
      BorderColor     =   &H00FF0000&
      BorderWidth     =   5
      Visible         =   0   'False
      X1              =   240
      X2              =   4080
      Y1              =   2760
      Y2              =   2760
   End
   Begin VB.Image imgMoon
      Height          =   480
      Index           =   7
      Left            =   5760
      Picture         =   "BLANKER.frx":091E
      Top             =   3720
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.Image imgMoon
      Height          =   480
      Index           =   6
      Left            =   5160
      Picture         =   "BLANKER.frx":0C28
      Top             =   3720
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.Image imgMoon
      Height          =   480
      Index           =   5
      Left            =   4560
      Picture         =   "BLANKER.frx":0F32
      Top             =   3720
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.Image imgMoon
      Height          =   480
      Index           =   4
      Left            =   3960
      Picture         =   "BLANKER.frx":123C
      Top             =   3720
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.Image imgMoon
      Height          =   480
      Index           =   3
      Left            =   3360
      Picture         =   "BLANKER.frx":1546
      Top             =   3720
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.Image imgMoon
      Height          =   480
      Index           =   2
      Left            =   2760
      Picture         =   "BLANKER.frx":1850
      Top             =   3720
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.Image imgMoon
      Height          =   480
      Index           =   1
      Left            =   2160
      Picture         =   "BLANKER.frx":1B5A
      Top             =   3720
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.Image imgMoon
      Height          =   480
      Index           =   0
      Left            =   1560
      Picture         =   "BLANKER.frx":1E64
      Top             =   3720
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.Shape shpClone
      BackColor       =   &H00000000&
      BackStyle       =   1  'Opaque
      BorderColor     =   &H00FF0000&
      FillColor       =   &H000000FF&
      Height          =   1215
      Index           =   0
      Left            =   240
      Top             =   720
      Visible         =   0   'False
      Width           =   1410
   End
   Begin VB.Shape Shape1
      Height          =   15
      Left            =   960
      Top             =   1080
      Width           =   15
   End
   Begin VB.Menu mnuOption
      Caption         =   "&Opciones"
      Begin VB.Menu mnuLineCtlDemo
         Caption         =   "&Lφnea saltarina"
         Checked         =   -1  'True
      End
      Begin VB.Menu mnuCtlMoveDemo
         Caption         =   "&Rebotes"
      End
      Begin VB.Menu mnuImageDemo
         Caption         =   "L&una giratoria"
      End
      Begin VB.Menu mnuShapeDemo
         Caption         =   "&Manicomio"
      End
      Begin VB.Menu mnuPSetDemo
         Caption         =   "&Confetti"
      End
      Begin VB.Menu mnuLineDemo
         Caption         =   "&Fuego cruzado"
      End
      Begin VB.Menu mnuCircleDemo
         Caption         =   "&Tapiz de arco iris"
      End
      Begin VB.Menu mnuScaleDemo
         Caption         =   "&Barra de colores"
      End
      Begin VB.Menu sep1
         Caption         =   "-"
      End
      Begin VB.Menu mnuExit
         Caption         =   "&Salir"
      End
   End
End
Attribute VB_Name = "DemoForm"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
' Declara una variable para seguir el marco de la animaci≤n.
Dim Shared FrameNum
' Declara las variables de las coordenadas X e Y, que mantienen la posici≤n.
Dim Shared XPos
Dim Shared YPos
' Declara una variable indicadora que para los procedimientos de dibujo
' de grßficos en el bucle "Do Loops".
Dim Shared DoFlag
' Declara una variable para seguir los controles de movimiento.
Dim Shared Motion
' Declara las variables del formulario para color.
Dim R
Dim G
Dim B

Private Sub CircleDemo()
    ' Declara variables locales.
    Dim Radius
    ' Crea colores RGB aleatorios.
    R = 255 * Rnd
    G = 255 * Rnd
    B = 255 * Rnd
    ' Sit·a el centro de los cφrculos en el centro del formulario.
    XPos = ScaleWidth / 2
    YPos = ScaleHeight / 2
    ' Genera un radio comprendido entre 0 y casi la mitad de la altura
    ' del formulario.
    Radius = ((YPos * 0.9) + 1) * Rnd
    ' Dibuja un cφrculo en el formulario.
    Circle (XPos, YPos), Radius, RGB(R, G, B)
End Sub

Private Sub cmdStartStop_Click()
' Declara variables locales.
Dim UnClone
Dim MakeClone
Dim X1
Dim Y1
    Select Case DoFlag
        Case True
            cmdStartStop.Caption = "Comenzar la demostraci≤n"
            DoFlag = False
            mnuOption.Enabled = True
            If mnuCtlMoveDemo.Checked = True Then
                ' Oculta el grßfico otra vez.
                picBall.Visible = False
            ElseIf mnuLineDemo.Checked = True Then
                ' Elimina las lφneas del formulario.
                Cls
            ElseIf mnuShapeDemo.Checked = True Then
                ' Elimina todos los controles de tipo "Shape" cargados
                ' dinßmicamente.
                For UnClone = 1 To 20
                    Unload shpClone(UnClone)
                Next UnClone
                ' Restablece a negro el color de fondo del formulario.
                DemoForm.BackColor = QBColor(0)
                ' Limpia el formulario para que el cambio de color surta
                ' efecto.
                Refresh
            ElseIf mnuPSetDemo.Checked = True Then
                ' Elimina los trozos de confeti del formulario.
                Cls
            ElseIf mnuLineCtlDemo.Checked = True Then
                ' Oculta otra vez el control de lφnea.
                linLineCtl.Visible = False
                ' Quita cualquier pixel suelto que haya quedado despuΘs de
                ' esconder la lφnea.
                Cls
            ElseIf mnuImageDemo.Checked = True Then
                ' Esconde el grßfico saltando otra vez.
                imgMoon(0).Visible = False
            ElseIf mnuScaleDemo.Checked = True Then
                ' Borra el formulario.
                Cls
                ' Recupera la escala por defecto del formulario.
                Scale
            ElseIf mnuCircleDemo.Checked = True Then
                ' Elimina los cφrculos del formulario.
                Cls
            End If
        Case False
            cmdStartStop.Caption = "Parar la demostraci≤n"
            DoFlag = True
            mnuOption.Enabled = False
            If mnuCtlMoveDemo.Checked = True Then
                ' Establece como visible el control del cuadro de imagen.
                picBall.Visible = True
                ' Determina el movimiento inicial del grßfico de forma aleatoria.
                ' Los valores predeterminados van de 1 a 4.  El valor de la variable Motion
                ' determina que parte del bucle "Do Loop" se ejecuta.
                Motion = Int(4 * Rnd + 1)
            ElseIf mnuLineDemo.Checked = True Then
                ' Inicializa el generador de n·meros aleatorios.
                Randomize
                ' Establece el ancho de lφnea.
                DrawWidth = 2
                ' Establece las coordenadas X e Y con una posici≤n aleatoria en el formulario.
                X1 = Int(DemoForm.Width * Rnd + 1)
                Y1 = Int(DemoForm.Height * Rnd + 1)
            ElseIf mnuShapeDemo.Checked = True Then
                ' Carga dinßmicamente en el formulario una matriz de controles de
                ' formas con 20 controles.
                For MakeClone = 1 To 20
                    Load shpClone(MakeClone)
                Next MakeClone
            ElseIf mnuPSetDemo.Checked = True Then
                ' Establece el tama±o de los trozos de confeti.
                DrawWidth = 5
            ElseIf mnuLineCtlDemo.Checked = True Then
                ' Establece como visible el control de lφnea.
                linLineCtl.Visible = True
                ' Establece el grosor de lφnea tal como se verß.
                DrawWidth = 7
            ElseIf mnuImageDemo.Checked = True Then
                ' Establece como visible el grßfico de control de imagen.
                imgMoon(0).Visible = True
                ' Establece la imagen de animaci≤n inicial.
                FrameNum = 0
                ' Determina el movimiento inicial del grßfico que salta.
                ' Los valores de configuraci≤n van de 1 a 4.  El valor de la variable Motion
                ' determina que parte del bucle "Do Loop" se ejecuta.
                Motion = Int(4 * Rnd + 1)
            ElseIf mnuScaleDemo.Checked = True Then
                ' Inicializa el generador de n·meros aleatorios.
                Randomize
                ' Establece el contorno del cuadro para que los
                ' cuadros no se superpongan.
                DrawWidth = 1
                ' Establece el valor de la coordenada X al borde izquierdo del formulario.
                ' Establece la coordenada X del primer cuadro a 1, el segundo cuadro a 2,
                ' y asφ sucesivamente.
                ScaleLeft = 1
                ' Establece la coordenada Y de la parte superior del formulario a 10.
                ScaleTop = 10
                ' Establece el n·mero de unidades de ancho del formulario con un n·mero aleatorio
                ' comprendido entre 3 y 12.  Esto cambia el n·mero de cuadros dibujados cada vez que
                ' comienza el procedimiento.
                ScaleWidth = Int(13 * Rnd + 3)
                ' Establece el n·mero de unidades de altura del formulario a 10.  Entonces la
                ' altura de todos los cuadros va de 0 a 10, y la coordenada Y comienza en el borde
                ' inferior del formulario.
                ScaleHeight = -10
            ElseIf mnuCircleDemo.Checked = True Then
                ' Define el ancho del contorno del cφrculo.
                DrawWidth = 1
                ' Dibuja cφrculos con el estilo de lφneas punteadas.
                DrawStyle = vbDash
                ' Dibuja lφneas usando el pincel XOR, combinando los colores encontrados en
                ' el pincel o en el monitor, pero no en los dos.
                DrawMode = vbXorPen
            End If
    End Select
End Sub

Private Sub CtlMoveDemo()
    Select Case Motion
    Case 1
        ' Mueve el grßfico a la izquierda y hacia arriba 20 twips usando el mΘtodo Move.
        picBall.Move picBall.Left - 20, picBall.Top - 20
        ' Si el grßfico alcanza el borde izquierdo del formulario, se mueve a la
        ' derecha y hacia arriba.
        If picBall.Left <= 0 Then
            Motion = 2
        ' Si el grßfico alcanza el borde superior del formulario, se mueve a la
        ' izquierda y hacia abajo.
        ElseIf picBall.Top <= 0 Then
            Motion = 4
        End If
    Case 2
        ' Mueve el grßfico a la derecha y hacia arriba 20 twips.
        picBall.Move picBall.Left + 20, picBall.Top - 20
        ' Si el grßfico alcanza el borde derecho del formulario, se mueve a la izquierda y
        ' hacia arriba. Este procedimiento determina el borde derecho del formulario restando
        ' el ancho del grßfico del ancho del formulario.
        If picBall.Left >= (DemoForm.Width - picBall.Width) Then
            Motion = 1
        ' Si el grßfico alcanza el borde superior del formulario, se mueve a la derecha y
        ' hacia abajo.
        ElseIf picBall.Top <= 0 Then
            Motion = 3
        End If
    Case 3
        ' Mueve el grßfico a la derecha y hacia abajo 20 twips.
        picBall.Move picBall.Left + 20, picBall.Top + 20
        ' Si el grßfico alcanza el borde derecho del formulario, se mueve a la
        ' izquierda y hacia abajo.
        If picBall.Left >= (DemoForm.Width - picBall.Width) Then
            Motion = 4
        ' Si el grßfico alcanza el borde inferior del formulario, se mueve a la
        ' derecha y hacia arriba. Esta rutina determina el borde inferior del formulario
        ' restando la altura del grßfico de la altura del formulario menos 680 twips
        ' debido a la altura de la barra de tφtulo la barra de men·s.
        ElseIf picBall.Top >= (DemoForm.Height - picBall.Height) - 680 Then
            Motion = 2
        End If
    Case 4
        ' Mueve el grßfico a la izquierda y hacia abajo 20 twips.
        picBall.Move picBall.Left - 20, picBall.Top + 20
        ' Si el grßfico alcanza el borde izquierdo del formulario, se mueve a la
        ' derecha y hacia abajo.
        If picBall.Left <= 0 Then
            Motion = 3
        ' Si el grßfico alcanza el borde inferior del formulario, se mueve a la
        ' izquierda y hacia arriba.
        ElseIf picBall.Top >= (DemoForm.Height - picBall.Height) - 680 Then
            Motion = 1
        End If
    End Select
End Sub

Private Sub Delay()
    Dim Start
    Dim Check
    Start = Timer
    Do Until Check >= Start + 0.15
        Check = Timer
    Loop
End Sub

Private Sub Form_Load()
    DoFlag = False
End Sub

Private Sub Form_Resize()
    If mnuScaleDemo.Checked = True And DemoForm.WindowState = 0 Then
        ' Inicializa el generador de n·meros aleatorios.
        Randomize
        ' Establece el ancho de los contornos del cuadro como estrechos para que los
        ' cuadros no se superpongan.
        DrawWidth = 1
        ' Establece el valor de la coordenada X del lado izquierdo del formulario a 1.
        ' Esto facilita el establecer la posici≤n para cada cuadro.  El primer cuadro
        ' tiene la coordenada X a 1, el segundo tiene la coordenada X a 2, y asφ
        ' sucesivamente.
        ScaleLeft = 1
        ' Establece el valor de la coordenada Y del borde superior del formulario a 10.
        ScaleTop = 10
        ' Establece el n·mero de unidades del ancho del formulario a un n·mero aleatorio entre
        ' 3 y 12.  Esto cambia el n·mero de cuadros que son dibujados cada vez que el usuario
        ' inicia este procedimiento.
        ScaleWidth = Int(13 * Rnd + 3)
        ' Establece el n·mero de unidades de altura del formulario a -10.  Esto tiene
        ' dos efectos.  El primero, todos los cuadros tendrßn una altura que varφa de 0 a 10.
        ' El segundo, el valor negativo causa que la coordenada Y empiece en el borde
        ' inferior del formulario en lugar del superior.
        ScaleHeight = -10
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    End
End Sub

Private Sub ImageDemo()
    Select Case Motion
    Case 1
        ' Mueve el grßfico a la izquierda y hacia arriba 100 twips usando el mΘtodo Move.
        imgMoon(0).Move imgMoon(0).Left - 100, imgMoon(0).Top - 100
        ' Incrementa la animaci≤n a la siguiente imagen.
        IncrFrame
        ' Si el grßfico alcanza el borde izquierdo del formulario, se mueve a la derecha
        ' y hacia arriba.
        If imgMoon(0).Left <= 0 Then
            Motion = 2
        ' Si el grßfico alcanza el borde superior del formulario, se mueve a la
        ' izquierda y hacia abajo.
        ElseIf imgMoon(0).Top <= 0 Then
            Motion = 4
        End If
    Case 2
        ' Mueve el grßfico a la derecha y hacia arriba 100 twips.
        imgMoon(0).Move imgMoon(0).Left + 100, imgMoon(0).Top - 100
        ' Incrementa la animaci≤n con la siguiente imagen.
        IncrFrame
        ' Si el grßfico alcanza el borde derecho del formulario, se mueve a la izquierda
        ' y hacia arriba. Este procedimiento determina el borde derecho del formulario restando
        ' el ancho del grßfico del ancho del control.
        If imgMoon(0).Left >= (DemoForm.Width - imgMoon(0).Width) Then
            Motion = 1
        ' Si el grßfico alcanza el borde superior del el formulario, se mueve a la derecha
        ' y hacia abajo.
        ElseIf imgMoon(0).Top <= 0 Then
            Motion = 3
        End If
    Case 3
        ' Mueve el grßfico a la derecha y hacia abajo 100 twips.
        imgMoon(0).Move imgMoon(0).Left + 100, imgMoon(0).Top + 100
        ' Incrementa la animaci≤n con la siguiente imagen.
        IncrFrame
        ' Si el grßfico alcanza el borde derecho del formulario, se mueve a la izquierda
        ' y hacia abajo.
        If imgMoon(0).Left >= (DemoForm.Width - imgMoon(0).Width) Then
            Motion = 4
        ' Si el grßfico alcanza el borde inferior del formulario, se mueve a la derecha y
        ' hacia arriba. Este procedimiento determina el borde inferior del formulario restando
        ' la altura del grßfico de la altura del formulario menos 680 twips debido a la altura
        ' de la barra del tφtulo y de la barra de men·s.
        ElseIf imgMoon(0).Top >= (DemoForm.Height - imgMoon(0).Height) - 680 Then
            Motion = 2
        End If
    Case 4
        ' Mueve el grßfico a la izquierda y hacia abajo 100 twips.
        imgMoon(0).Move imgMoon(0).Left - 100, imgMoon(0).Top + 100
        ' Incrementa la animaci≤n con la siguiente imagen.
        IncrFrame
        ' Si el grßfico alcanza el borde izquierdo del formulario, se mueve a la derecha y
        ' hacia abajo.
        If imgMoon(0).Left <= 0 Then
            Motion = 3
        ' Si el grßfico alcanza el borde inferior del formulario, se mueve a la izquierda y
        ' hacia arriba.
        ElseIf imgMoon(0).Top >= (DemoForm.Height - imgMoon(0).Height) - 680 Then
            Motion = 1
        End If
    End Select
End Sub

Private Sub IncrFrame()
    ' Incrementa el n·mero de imagen.
    FrameNum = FrameNum + 1
    ' La matriz de controles con animaci≤n de imßgenes tiene elementos de 0 a 7. A
    ' la octava imagen, se restablece el n·mero de imagen a 0 para un bucle de
    ' animaci≤n sin fin.
    If FrameNum > 8 Then
        FrameNum = 1
    End If
    ' Establece la propiedad Picture del control de imagen con la propiedad Picture
    ' de la imagen actual.
    imgMoon(0).Picture = imgMoon(FrameNum).Picture
    ' Se genera una pausa para que la animaci≤n no sea demasiado rßpida.
    Delay
End Sub

Private Sub LineCtlDemo()
    ' Establece las coordenadas X e Y (posici≤n izquierda/derecha) de la posici≤n inicial de
    ' la lφnea a una posici≤n aleatoria del formulario.
    linLineCtl.X1 = Int(DemoForm.Width * Rnd)
    linLineCtl.Y1 = Int(DemoForm.Height * Rnd)
    ' Establece las coordenadas X e Y (posici≤n izquierda/derecha) de la posici≤n final de la
    ' lφnea a una posici≤n aleatoria del formulario.
    linLineCtl.X2 = Int(DemoForm.Width * Rnd)
    linLineCtl.Y2 = Int(DemoForm.Height * Rnd)
    ' Borra el formulario para eliminar cualquier pixel residual.
    Cls
    ' Realiza una pausa antes de mover de nuevo la lφnea.
    Delay
End Sub

Private Sub LineDemo()
    ' Declara variables locales.
    Dim X2
    Dim Y2
    ' Crea colores RGB aleatorios.
    R = 255 * Rnd
    G = 255 * Rnd
    B = 255 * Rnd
    ' Establece el punto de destino del control de lφnea a una posici≤n aleatoria
    ' en el formulario.
    X2 = Int(DemoForm.Width * Rnd + 1)
    Y2 = Int(DemoForm.Height * Rnd + 1)
    ' Usando el mΘtodo Line, dibuja de las coordenadas actuales al punto de destino,
    ' dßndole un color aleatorio a la lφnea. Cada lφnea empieza donde acaba la ·ltima lφnea.
    Line -(X2, Y2), RGB(R, G, B)
End Sub

Private Sub mnuCircleDemo_Click()
    Cls
    mnuCtlMoveDemo.Checked = False
    mnuLineDemo.Checked = False
    mnuShapeDemo.Checked = False
    mnuPSetDemo.Checked = False
    mnuLineCtlDemo.Checked = False
    mnuImageDemo.Checked = False
    mnuScaleDemo.Checked = False
    mnuCircleDemo.Checked = True
End Sub

Private Sub mnuCtlMoveDemo_Click()
    Cls
    mnuCtlMoveDemo.Checked = True
    mnuLineDemo.Checked = False
    mnuShapeDemo.Checked = False
    mnuPSetDemo.Checked = False
    mnuLineCtlDemo.Checked = False
    mnuImageDemo.Checked = False
    mnuScaleDemo.Checked = False
    mnuCircleDemo.Checked = False
End Sub

Private Sub mnuExit_Click()
    End
End Sub

Private Sub mnuImageDemo_Click()
    Cls
    mnuCtlMoveDemo.Checked = False
    mnuLineDemo.Checked = False
    mnuShapeDemo.Checked = False
    mnuPSetDemo.Checked = False
    mnuLineCtlDemo.Checked = False
    mnuImageDemo.Checked = True
    mnuScaleDemo.Checked = False
    mnuCircleDemo.Checked = False
End Sub

Private Sub mnuLineCtlDemo_Click()
    Cls
    mnuCtlMoveDemo.Checked = False
    mnuLineDemo.Checked = False
    mnuShapeDemo.Checked = False
    mnuPSetDemo.Checked = False
    mnuLineCtlDemo.Checked = True
    mnuImageDemo.Checked = False
    mnuScaleDemo.Checked = False
    mnuCircleDemo.Checked = False
End Sub

Private Sub mnuLineDemo_Click()
    Cls
    mnuCtlMoveDemo.Checked = False
    mnuLineDemo.Checked = True
    mnuShapeDemo.Checked = False
    mnuPSetDemo.Checked = False
    mnuLineCtlDemo.Checked = False
    mnuImageDemo.Checked = False
    mnuScaleDemo.Checked = False
    mnuCircleDemo.Checked = False
End Sub

Private Sub mnuPSetDemo_Click()
    Cls
    mnuCtlMoveDemo.Checked = False
    mnuLineDemo.Checked = False
    mnuShapeDemo.Checked = False
    mnuPSetDemo.Checked = True
    mnuLineCtlDemo.Checked = False
    mnuImageDemo.Checked = False
    mnuScaleDemo.Checked = False
    mnuCircleDemo.Checked = False
End Sub

Private Sub mnuScaleDemo_Click()
    Cls
    mnuCtlMoveDemo.Checked = False
    mnuLineDemo.Checked = False
    mnuShapeDemo.Checked = False
    mnuPSetDemo.Checked = False
    mnuLineCtlDemo.Checked = False
    mnuImageDemo.Checked = False
    mnuScaleDemo.Checked = True
    mnuCircleDemo.Checked = False
End Sub

Private Sub mnuShapeDemo_Click()
    Cls
    mnuCtlMoveDemo.Checked = False
    mnuLineDemo.Checked = False
    mnuShapeDemo.Checked = True
    mnuPSetDemo.Checked = False
    mnuLineCtlDemo.Checked = False
    mnuImageDemo.Checked = False
    mnuScaleDemo.Checked = False
    mnuCircleDemo.Checked = False
End Sub

Private Sub PSetDemo()
    ' Crea colores RGB aleatorios.
    R = 255 * Rnd
    G = 255 * Rnd
    B = 255 * Rnd
    ' XPos establece la posici≤n horizontal de un bit de confeti con una
    ' posici≤n aleatoria del formulario.
    XPos = Rnd * ScaleWidth
    ' YPos establece la posici≤n vertical de un bit de confeti con una
    ' posici≤n aleatoria del formulario.
    YPos = Rnd * ScaleHeight
    ' Dibuja un bit de confeti en XPos, YPos. Asigna un color aleatorio
    ' al bit de confeti.
    PSet (XPos, YPos), RGB(R, G, B)
End Sub

Private Sub ScaleDemo()
    ' Declara variables locales.
    Dim Box
    ' Crea el mismo n·mero de cuadros que el ancho del formulario.
    For Box = 1 To ScaleWidth
    ' Crea colores RGB aleatorios.
        R = 255 * Rnd
        G = 255 * Rnd
        B = 255 * Rnd
        ' Dibuja cuadros usando el mΘtodo Line con las opciones B (cuadro) F (relleno).
        ' Los cuadros empiezan en la coordenada X determinada por ScaleWidth y en la
        ' coordenada Y de 0 (parte inferior del formulario). Cada cuadro tiene una
        ' anchura de 1 y tiene una altura aleatoria entre 0 y 10. Llena el cuadro con
        ' un color aleatorio.
        Line (Box, 0)-Step(1, (Int(11 * Rnd))), RGB(R, G, B), BF
    Next Box
    ' Realiza una pausa para mostrar todos los cuadros antes de volver a dibujar.
    Delay
End Sub

Private Sub ShapeDemo()
    ' Declara variables locales.
    Dim CloneID
    ' Crea colores RGB aleatorios.
    R = 255 * Rnd
    G = 255 * Rnd
    B = 255 * Rnd
    ' Establece el color de fondo del formulario con un valor aleatorio.
    DemoForm.BackColor = RGB(R, G, B)
    ' Selecciona un control figura aleatorio en la matriz de controles.
    CloneID = Int(20 * Rnd + 1)
    ' XPos y YPos establece la posici≤n del control de forma seleccionado
    ' una posici≤n aleatoria en el formulario.
    XPos = Int(DemoForm.Width * Rnd + 1)
    YPos = Int(DemoForm.Height * Rnd + 1)
    ' Establece la figura del control de forma seleccionado una figura aleatoria.
    shpClone(CloneID).Shape = Int(6 * Rnd)
    ' Establece el alto y ancho de un control de forma seleccionado un tama±o aleatorio entre
    ' 500 y 2500 twips.
    shpClone(CloneID).Height = Int(2501 * Rnd + 500)
    shpClone(CloneID).Width = Int(2501 * Rnd + 500)
    ' Establece el color de fondo y la propiedad DrawMode del control de forma con un color
    ' aleatorio.
    shpClone(CloneID).BackColor = QBColor(Int(15 * Rnd))
    shpClone(CloneID).DrawMode = Int(16 * Rnd + 1)
    ' Mueve el control de forma seleccionado a XPos, YPos.
    shpClone(CloneID).Move XPos, YPos
    ' Establece como visible el control de forma seleccionado.
    shpClone(CloneID).Visible = True
    ' Espera brevemente antes de seleccionar y cambiar el pr≤ximo control de forma.
    Delay
End Sub

Private Sub Timer1_Timer()
    If mnuCtlMoveDemo.Checked And DoFlag = True Then
        CtlMoveDemo
    ElseIf mnuLineDemo.Checked And DoFlag = True Then
        LineDemo
    ElseIf mnuShapeDemo.Checked And DoFlag = True Then
        ShapeDemo
    ElseIf mnuPSetDemo.Checked And DoFlag = True Then
        PSetDemo
    ElseIf mnuLineCtlDemo.Checked And DoFlag = True Then
        LineCtlDemo
    ElseIf mnuImageDemo.Checked And DoFlag = True Then
        ImageDemo
    ElseIf mnuScaleDemo.Checked And DoFlag = True Then
        ScaleDemo
    ElseIf mnuCircleDemo.Checked And DoFlag = True Then
        CircleDemo
    End If
End Sub